OHI British Columbia | OHI Science | Citation policy
OHI British Columbia | OHI Science | Citation policy
knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.path = 'Figs/',
echo = TRUE, message = FALSE, warning = FALSE)
library(ohicore) ### devtools::install_github('ohi-science/ohicore')
source('~/github/ohibc/src/R/common.R')
dir_ohibc <- '~/github/ohibc'
dir_calc <- file.path(dir_ohibc, 'calc_ohibc')
dir_master <- file.path(dir_calc, 'master')
source(file.path(dir_calc, 'calc_scores_fxns.R'))
### provenance tracking
# library(provRmd); prov_setup()prs_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(dimension %in% c('pressures')) %>%
left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))
for(goalname in prs_scores$goal %>% unique() %>% sort) {
# goalname <- prs_scores$goal[1]
scores_tmp <- prs_scores %>%
filter(goal == goalname)
prs_plot <- ggplot(scores_tmp %>%
filter(region_id != 0),
aes(x = year, y = score, color = rgn_name)) +
ggtheme_plot() +
geom_line(aes(group = region_id), alpha = .7, size = 1.5) +
scale_x_continuous(breaks = scores_tmp$year[scores_tmp$year %% 5 == 0] %>%
unique() %>%
sort) +
scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
brewer.pal(n = 8, name = 'Pastel2'),
'purple4', 'orange4', 'blue4')) +
# scale_y_continuous(limits = c(-1, 1)) +
labs(color = paste0('Prs: ', goalname),
y = paste0('Pressure on ', goalname)) +
guides(colour = guide_legend(override.aes = list(size = 3)))
print(prs_plot)
}
prs_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(dimension %in% c('pressures', 'resilience', 'status')) %>%
filter(region_id != 0) %>%
filter(!goal %in% c('FP', 'BD', 'ES', 'SP', 'Index')) %>%
spread(dimension, score) %>%
left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))
prs_layers <- read_csv(file.path(dir_calc, 'checks/layers_full_list.csv')) %>%
filter(dimension == 'pressure') %>%
filter(!str_detect(layer, 'element_wt')) %>%
filter(!is.na(dir_prep)) %>%
select(layer, target, target_element, dir_prep, filename, name_data_fld) %>%
distinct()
prs_files <- prs_layers %>%
select(layer, dir_prep, filename, name_data_fld) %>%
mutate(dir_prep = str_replace(dir_prep, 'ohibc:', '~/github/ohibc/')) %>%
distinct()
prs_data <- lapply(seq_along(prs_files$layer), FUN = function(i) {
### i <- 12
x <- read_csv(file.path(prs_files$dir_prep[i], prs_files$filename[i])) %>%
rename_('pressure' = prs_files$name_data_fld[i])
}) %>%
setNames(prs_files$layer) %>%
bind_rows(.id = 'layer') %>%
select(layer, rgn_id, year, pressure)
prs_data_all <- prs_data %>%
filter(is.na(year)) %>%
group_by(layer, rgn_id) %>%
mutate(year = 2016) %>%
complete(year = 2000:2016) %>%
fill(pressure, .direction = 'up') %>%
ungroup() %>%
bind_rows(prs_data %>%
filter(!is.na(year) & year >= 2000)) %>%
mutate(pressure = 100 * pressure)
for(goalname in prs_scores$goal %>% unique() %>% sort) {
# goalname <- prs_scores$goal[1]
scores_tmp <- prs_scores %>%
filter(goal == goalname)
layers_tmp <- prs_layers %>%
filter(target == goalname) %>%
left_join(prs_data_all, by = 'layer') %>%
select(layer, target_element, rgn_id, year, pressure) %>%
left_join(get_rgn_names(), by = 'rgn_id') %>%
filter(!is.na(rgn_id)) %>%
filter(rgn_id %in% scores_tmp$region_id) %>%
distinct()
if(all(is.na(layers_tmp$target_element))) {
prs_plot <- ggplot(layers_tmp,
aes(x = year, y = pressure, color = layer)) +
ggtheme_plot() +
# geom_line(data = scores_tmp %>%
# filter(region_id != 0),
# aes(x = year, y = score), alpha = .7) +
geom_line(data = scores_tmp, aes(y = pressures), color = 'darkred', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
geom_line(aes(group = layer), alpha = 1, size = .5) +
scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>%
unique() %>%
sort) +
scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
brewer.pal(n = 8, name = 'Pastel2'),
'purple4', 'orange4', 'blue4')) +
# scale_y_continuous(limits = c(-1, 1)) +
theme(axis.text.x = element_text(angle = 75)) +
labs(color = paste0('Prs: ', goalname),
y = paste0('Pressure on ', goalname)) +
guides(colour = guide_legend(override.aes = list(size = 3))) +
facet_wrap( ~ rgn_name)
print(prs_plot)
} else {
for(target in layers_tmp$target_element %>% unique()) {
### target = layers_tmp$target_element[1]
layers_target <- layers_tmp %>%
filter(target_element == target)
prs_plot <- ggplot(layers_target,
aes(x = year, y = pressure, color = layer)) +
ggtheme_plot() +
# geom_line(data = scores_tmp %>%
# filter(region_id != 0),
# aes(x = year, y = score), alpha = .7) +
geom_line(data = scores_tmp, aes(y = pressures), color = 'darkred', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
geom_line(aes(group = layer), alpha = 1, size = .5) +
scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>%
unique() %>%
sort) +
scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
brewer.pal(n = 8, name = 'Pastel2'),
'purple4', 'orange4', 'blue4')) +
# scale_y_continuous(limits = c(-1, 1)) +
theme(axis.text.x = element_text(angle = 75)) +
labs(color = paste0('Prs: ', goalname),
y = paste0('Pressure on ', goalname, ': ', target)) +
guides(colour = guide_legend(override.aes = list(size = 3))) +
facet_wrap( ~ rgn_name)
print(prs_plot)
}
}
}
res_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(dimension %in% c('resilience')) %>%
left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))
for(goalname in res_scores$goal %>% unique() %>% sort) {
# goalname <- scores$goal[1]
scores_tmp <- res_scores %>%
filter(goal == goalname)
res_plot <- ggplot(scores_tmp %>%
filter(region_id != 0),
aes(x = year, y = score, color = rgn_name)) +
ggtheme_plot() +
geom_line(aes(group = region_id), alpha = .7, size = 1.5) +
scale_x_continuous(breaks = scores_tmp$year[scores_tmp$year %% 5 == 0] %>%
unique() %>%
sort) +
scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
brewer.pal(n = 8, name = 'Pastel2'),
'purple4', 'orange4', 'blue4')) +
# scale_y_continuous(limits = c(-1, 1)) +
labs(color = paste0('Res: ', goalname),
y = paste0('Resilience on ', goalname)) +
guides(colour = guide_legend(override.aes = list(size = 3)))
print(res_plot)
}
res_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(dimension %in% c('pressures', 'resilience', 'status')) %>%
filter(region_id != 0) %>%
filter(!goal %in% c('FP', 'BD', 'ES', 'SP', 'Index')) %>%
spread(dimension, score) %>%
left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))
res_layers <- read_csv(file.path(dir_calc, 'checks/layers_full_list.csv')) %>%
filter(dimension == 'resilience') %>%
filter(!str_detect(layer, 'element_wt')) %>%
filter(!is.na(dir_prep)) %>%
select(layer, target, target_element, dir_prep, filename, name_data_fld) %>%
distinct()
res_files <- res_layers %>%
select(layer, dir_prep, filename, name_data_fld) %>%
mutate(dir_prep = str_replace(dir_prep, 'ohibc:', '~/github/ohibc/')) %>%
distinct()
res_data <- lapply(seq_along(res_files$layer), FUN = function(i) {
### i <- 12
x <- read_csv(file.path(res_files$dir_prep[i], res_files$filename[i])) %>%
rename_('pressure' = res_files$name_data_fld[i])
}) %>%
setNames(res_files$layer) %>%
bind_rows(.id = 'layer') %>%
select(layer, rgn_id, year, pressure)
res_data_all <- res_data %>%
filter(is.na(year)) %>%
group_by(layer, rgn_id) %>%
mutate(year = 2016) %>%
complete(year = 2000:2016) %>%
fill(pressure, .direction = 'up') %>%
ungroup() %>%
bind_rows(res_data %>%
filter(!is.na(year) & year >= 2000)) %>%
mutate(pressure = 100 * pressure)
for(goalname in res_scores$goal %>% unique() %>% sort) {
# goalname <- res_scores$goal[1]
scores_tmp <- res_scores %>%
filter(goal == goalname)
layers_tmp <- res_layers %>%
filter(target == goalname) %>%
left_join(res_data_all, by = 'layer') %>%
select(layer, target_element, rgn_id, year, pressure) %>%
left_join(get_rgn_names(), by = 'rgn_id') %>%
filter(!is.na(rgn_id)) %>%
filter(rgn_id %in% scores_tmp$region_id) %>%
distinct()
if(all(is.na(layers_tmp$target_element))) {
res_plot <- ggplot(layers_tmp,
aes(x = year, y = pressure, color = layer)) +
ggtheme_plot() +
# geom_line(data = scores_tmp %>%
# filter(region_id != 0),
# aes(x = year, y = score), alpha = .7) +
geom_line(data = scores_tmp, aes(y = pressures), color = 'darkred', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
geom_line(aes(group = layer), alpha = 1, size = .5) +
scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>%
unique() %>%
sort) +
scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
brewer.pal(n = 8, name = 'Pastel2'),
'purple4', 'orange4', 'blue4')) +
# scale_y_continuous(limits = c(-1, 1)) +
theme(axis.text.x = element_text(angle = 75)) +
labs(color = paste0('Res: ', goalname),
y = paste0('Resilience on ', goalname)) +
guides(colour = guide_legend(override.aes = list(size = 3))) +
facet_wrap( ~ rgn_name)
print(res_plot)
} else {
for(target in layers_tmp$target_element %>% unique()) {
### target = layers_tmp$target_element[1]
layers_target <- layers_tmp %>%
filter(target_element == target)
res_plot <- ggplot(layers_target,
aes(x = year, y = pressure, color = layer)) +
ggtheme_plot() +
# geom_line(data = scores_tmp %>%
# filter(region_id != 0),
# aes(x = year, y = score), alpha = .7) +
geom_line(data = scores_tmp, aes(y = pressures), color = 'darkred', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
geom_line(aes(group = layer), alpha = 1, size = .5) +
scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>%
unique() %>%
sort) +
scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
brewer.pal(n = 8, name = 'Pastel2'),
'purple4', 'orange4', 'blue4')) +
# scale_y_continuous(limits = c(-1, 1)) +
theme(axis.text.x = element_text(angle = 75)) +
labs(color = paste0('Res: ', goalname),
y = paste0('Resilience on ', goalname, ': ', target)) +
guides(colour = guide_legend(override.aes = list(size = 3))) +
facet_wrap( ~ rgn_name)
print(res_plot)
}
}
}
Dark grey is status; grey dotted is score; red is pressures; green is resilience.
scores_overall <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(dimension != 'future') %>%
filter(region_id != 0) %>%
filter(!goal %in% c('Index', 'SP', 'FP', 'BD', 'ES')) %>% ### ditch supragoals
group_by(goal, dimension, year) %>%
summarize(mean_score = mean(score, na.rm = TRUE)) %>%
ungroup() %>%
spread(dimension, mean_score)
dim_plot <- ggplot(scores_overall,
aes(x = year, y = status)) +
ggtheme_plot() +
geom_line(color = 'grey20', alpha = .7, size = 1.5) +
geom_line(aes(y = score),
color = 'grey30', linetype = '1111',alpha = .7, size = 1) +
geom_line(aes(y = pressures), color = 'darkred', alpha = .7, size = .5) +
geom_line(aes(y = resilience), color = 'darkgreen', alpha = .7, size = .5) +
scale_x_continuous(breaks = scores_tmp$year %>% unique() %>% sort) +
scale_y_continuous(limits = c(0, 100)) +
theme(axis.text.x = element_text(angle = 90),
axis.title.y = element_blank()) +
facet_wrap( ~ goal)
print(dim_plot)
Several new pressures layers and categories have been added to OHIBC. For the global OHI, pressures scores were determined through expert opinion and carefully referenced; for OHIBC pressures that are unchanged from global, these references should still be valid. For scores or layers that have been adjusted or added, we may need to determine new sources to justify these changes.
prs_ohibc <- read_csv(file.path(dir_calc, 'master/pressures_matrix_master.csv')) %>%
select(-element_name) %>%
gather(pressure, bc_magn, -goal, -element)
prs_global <- read_csv('~/github/ohi-global/eez/conf/pressures_matrix.csv') %>%
select(-element_name) %>%
gather(pressure, gl_magn, -goal, -element) %>%
mutate(element = str_replace(element, 'mangrove', 'coastal_forest')) %>%
### closest analog to BC coastal forests
mutate(goal = ifelse(goal == 'CS', 'CSS', goal),
goal = ifelse(goal == 'CP', 'CPP', goal),
goal = ifelse(goal == 'LIV', 'LE', goal))
### adjust goal names to match
goal_mismatch <- prs_global %>%
select(goal, element) %>%
filter(!goal %in% prs_ohibc$goal | (!is.na(element) & !element %in% prs_ohibc$element)) %>%
distinct() %>%
mutate(drop = TRUE)
prs_compare <- prs_ohibc %>%
full_join(prs_global, by = c('goal', 'element', 'pressure')) %>%
filter(pressure %in% prs_ohibc$pressure) %>%
filter(!is.na(bc_magn) | !is.na(gl_magn)) %>%
left_join(goal_mismatch, by = c('goal', 'element')) %>%
filter(!drop | is.na(drop)) %>%
select(-drop) %>%
mutate(delta = case_when(is.na(bc_magn) & !is.na(gl_magn) ~ 'drop',
is.na(gl_magn) & !is.na(bc_magn) ~ 'add',
bc_magn == gl_magn ~ 'no change',
bc_magn < gl_magn ~ 'reduce',
bc_magn > gl_magn ~ 'increase',
TRUE ~ 'missed a case somewhere'))
DT::datatable(prs_compare)